R Notebook

Libraries

library(lattice)
library(ISLR)
library(MASS)
library(caret)

Loading required package: ggplot2

library(tidyverse)

── Attaching packages ────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ tibble  2.0.1     ✔ purrr   0.3.2
✔ tidyr   0.8.3     ✔ dplyr   0.8.3
✔ readr   1.3.1     ✔ stringr 1.3.1
✔ tibble  2.0.1     ✔ forcats 0.4.0
── Conflicts ───────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
✖ purrr::lift()   masks caret::lift()
✖ dplyr::select() masks MASS::select()

library(rpart)
library(plyr); library(dplyr)

-------------------------------------------------------------------------------------------------------------
You have loaded plyr after dplyr - this is likely to cause problems.
If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
library(plyr); library(dplyr)
-------------------------------------------------------------------------------------------------------------

Attaching package: ‘plyr’

The following objects are masked from ‘package:dplyr’:

    arrange, count, desc, failwith, id, mutate, rename, summarise, summarize

The following object is masked from ‘package:purrr’:

    compact

library(caret)
library(rattle)                 # Fancy tree plot

Rattle: A free graphical interface for data science with R.
Version 5.2.0 Copyright (c) 2006-2018 Togaware Pty Ltd.
Type 'rattle()' to shake, rattle, and roll your data.

library(rpart.plot) 
library(dplyr)
library(parallel)
library(Hmisc)

Loading required package: survival

Attaching package: ‘survival’

The following object is masked _by_ ‘.GlobalEnv’:

    heart

The following object is masked from ‘package:rpart’:

    solder

The following object is masked from ‘package:caret’:

    cluster

Loading required package: Formula

Attaching package: ‘Hmisc’

The following objects are masked from ‘package:plyr’:

    is.discrete, summarize

The following objects are masked from ‘package:dplyr’:

    src, summarize

The following object is masked from ‘package:e1071’:

    impute

The following objects are masked from ‘package:base’:

    format.pval, units

library(e1071)
library(pROC)

Type 'citation("pROC")' for a citation.

Attaching package: ‘pROC’

The following objects are masked from ‘package:stats’:

    cov, smooth, var

library(ggplot2)
library(rpart.plot)
library(VIM)

Loading required package: colorspace

Attaching package: ‘colorspace’

The following object is masked from ‘package:pROC’:

    coords

Loading required package: grid
Loading required package: data.table
data.table 1.12.2 using 4 threads (see ?getDTthreads).  Latest news: r-datatable.com

Attaching package: ‘data.table’

The following objects are masked from ‘package:dplyr’:

    between, first, last

The following object is masked from ‘package:purrr’:

    transpose

VIM is ready to use. 
 Since version 4.0.0 the GUI is in its own package VIMGUI.

          Please use the package to use the new (and old) GUI.

Suggestions and bug-reports can be submitted at: https://github.com/alexkowa/VIM/issues

Attaching package: ‘VIM’

The following object is masked from ‘package:datasets’:

    sleep

library(mice)

Attaching package: ‘mice’

The following object is masked from ‘package:tidyr’:

    complete

The following objects are masked from ‘package:base’:

    cbind, rbind

# Reading the dataset
nbi <- read.csv('../../../data/trees/decision-tree-dataset/decision_tree.csv')
# Select attributesk
df <- nbi %>% dplyr::select(adt.cat, adtt.cat, material, state, structure.number, structure.type, type.of.wearing.surface, current.deck, current.substructure, current.superstructure, total.deck.intervention, total.sub.intervention, total.super.intervention, deck.intervention.in.next.3.years, sub.intervention.in.next.3.years, super.intervention.in.next.3.years, precipitation, snowfall, freezethaw, score)

Dataset to model deck of the bridges

# Select attributes
df_deck <- nbi %>% dplyr::select(adt.cat, adtt.cat, material, structure.type, type.of.wearing.surface, current.deck, current.substructure, current.superstructure, total.deck.intervention, total.sub.intervention, total.super.intervention,  precipitation, snowfall, freezethaw, score, deck.intervention.in.next.3.years)
# Remove null values
df_deck <- na.omit(df_deck)

Preview of the data

head(df_deck)

Training and testing Deck

target_variable <- 'deck.intervention.in.next.3.years'
index = createDataPartition(y=df_deck[[target_variable]], p=0.7, list=FALSE)
train.set = df_deck[index,]
test.set = df_deck[-index,]
positive_class = 'No'
negative_class = 'Yes' 
reset.seed <- function()
{
  # ensure results are repeatable
  set.seed(1337)
}
library(doParallel)
num_cores <- detectCores() #note: you can specify a smaller number if you want
cl <- makePSOCKcluster(num_cores)
registerDoParallel(cl)
reset.seed()
model <- deck.intervention.in.next.3.years ~ adt.cat + adtt.cat + material + structure.type + type.of.wearing.surface + current.deck + current.substructure + current.superstructure + total.deck.intervention + total.sub.intervention + total.super.intervention +  precipitation + snowfall + freezethaw + score
tunelengths = seq(from=5, to=10, by=5)
list_sens <- c()
list_spec <- c()
list_f1 <-c()
list_tl <-c()
list_kappa <-c()
list_auc <- c()
probabilities_dt <- data.frame(No=double(), Yes=double())
for(tl in tunelengths) {
rtree_model = train( model,
                 data = train.set,
                 method = "rpart",
                 trControl = trainControl(method = "repeatedcv", search = 'random', repeats = 5,
                                          summaryFunction = twoClassSummary,
                                          classProbs = T, savePredictions = T),  tuneLength = tl,
                 metric='ROC')
rtree_model
# Predict on the training set
tree_class_test <- rtree_model%>% predict(newdata = test.set, type = 'raw')
tree_prob_test <- rtree_model%>% predict(newdata = test.set, type = 'prob')
# Confusion Matrix
metrics <- confusionMatrix(tree_class_test, test.set[[target_variable]])
metricsbyclass <- metrics$byClass
sens <- type.convert(metricsbyclass[1])
list_sens <- c(list_sens, sens)
spec <- type.convert(metricsbyclass[2])
list_spec <- c(list_spec, spec)
f1 <- type.convert(metricsbyclass[7])
list_f1 <- c(list_f1, f1)
tunelen <- tl
list_tl <- c(list_tl, tunelen)
kappa <- type.convert(metrics$overall[2])
list_kappa <- c(list_kappa, kappa)
# Confusion matrix
area <- roc(test.set[[target_variable]], tree_prob_test[[positive_class]], plot = TRUE, print.auc = TRUE, legacy.axes = TRUE)
list_auc <- c(list_auc, area$auc)
# rpart model
rpart.plot(rtree_model$finalModel)
filename <-paste('../../../data/trees/models/deck/tree-deck-no-undersample', toString(tl), '.csv', collapse = '')
write.csv(rpart.rules(rtree_model$finalModel, roundint=FALSE, clip.facs=TRUE), filename)
# Probability values
tree_prob_test['Tunelength'] <- rep(tl, length(tree_class_test))
tree_prob_test['StructureNumber'] <- df[rownames(tree_prob_test),]$structure.number
# Concatenate
probabilities_dt <- bind_rows(probabilities_dt, tree_prob_test)
# metrics
metrics
}

Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 18 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 17 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 16 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 15 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 14 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 13 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 12 (<-localhost:11814)
Warning in .Internal(gc(verbose, reset, full)) :
  closing unused connection 11 (<-localhost:11814)
Setting levels: control = No, case = Yes
Setting direction: controls > cases

df_metric_dt <- data.frame(list_sens, list_spec, list_f1, list_tl, list_kappa, list_auc)
names(df_metric_dt) <- c('Sensitivity', 'Specificity', 'F1','Tunelength', 'Kappa', 'AUC')
# Writing outputs
write.csv(probabilities_dt, '../../../data/trees/metrics/dt/tree-prob-deck-nou.csv')
write.csv(probabilities_dt, '../../../data/trees/metrics/dt/tree-metric-deck-nou.csv')
write.csv(df_metric_dt, '../../../data/trees/metrics/dt/tree-metric-deck-nou.csv')
df_metric_dt

probabilities_dt